home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
batchut
/
rap101.zip
/
COMMON.SRC
< prev
next >
Wrap
Text File
|
1989-05-10
|
38KB
|
1,494 lines
; COMMON.RAP -- standard interaction routines for RAP
; copyright 1988 SIL
;
; Gary F. Simons, SIL / Kirk Parker, SIL
;
; Version 1.01 - 10 May 1989
; a. #filesize now reports in Kbytes
; b. *get_input_file now detects non-existent files
; Version 1.0 - Released 10 Oct 1988
; previously major version: 23 September 1988 khp for RAP 0.88
;
;----------------------------------------------------------
;
; This file contains loose code, which enables it to declare some
; "truly" global variables and to execute some start-up code.
; As a result, this file is sensitive to the order in which it is loaded:
;
; 1. COMMON.RAP must be .included before all other program files that
; contain subroutines. It is still possible to include other files
; ahead of COMMON.RAP as long as those files contain only loose code
; and/or .define statements.
;
; 2. No file loaded after COMMON.RAP may contain loose code.
;
; While this will restrict the use of loose code by user programs, the
; benefits of using the subroutine library far outweigh this minor drawback.
; Note that using a main subroutine results in a better-documented program
; anyway!
.define .LOCALMATCH declare $left,$match,$right
.define .BELL t:*chr(7)\
.define .YES 1
.define .NO 0
; return values from *existf:
.define .NOTFOUND 0
.define .READWRITE 2
.define .READONLY 4
.define .MININT (-2147483639)
.define .MAXINT 2147483639
; longest allowed slashcode:
.define .MAXCODE 78
; valid filename chars:
.define .FILECHARS a-z0-9_A-Z!@#$%^&()'`{}~\-
; 0 - (amount of extra space desired) for ensure_space
.define .HEADROOM -10240
;----------------------------------------------------------
; the following variables must be declared at the global level
; this group is documented as accessible to the user:
#verbose=1 ; are explanations enabled? default = yes
if ($screentype == "Sharp LCD") ; inter-line spacing for query routines
$skip=$null
else
$skip=$newline*chr(13)
endif
$valdr=*getdr__() ; list of valid disk drives
; this group is non-documented and for internal use only
#help__= -1 ; help-file descriptor. default = help file not opened
; help file name for closing/reopening (default = none)
$helpfile__=
$dospath__=$path ; save original PATH so we can access it from library
; routines even if caller changes $path
;------------------------------------------------------------
; error
;
; effect: Sound the alarm and display an error message. If help
; is available, tell the user about it.
;
; inputs: $message the message to display
; $topic the help topic pertinent to the question that
; was answered incorrectly
;
proc error($message,$topic)
declare $tag,$indent
.LOCALMATCH
; add a period to message if needed
if (not ($message contains "[.!?]$"))
$message=$message.
endif
if ($message contains "^[ \\t][ \\t]*") ; we want the side effect only
$indent=$match
endif
t:$skip*chr(7)$message\
if ($topic == "")
$tag=Try again.
else
$tag=Try again. (Type ? for help.)
endif
; terminate line if tag won't fit, indent next line same as message
if ((*strlen($message) + *strlen($tag)) > 72)
t:
t:$indent\
else
t: \
endif
t:$tag
endproc
; ----------------------------------------------------------
; warning
;
; effect: Ring alarm and display message. wait until user enters RETURN
;
proc warning($message)
if (not $message has "\\.?!$")
$message=$message.
endif
t:$skip*chr(7)$message.
kbflush()
foot
endproc
;------------------------------------------------------------
; mount
;
; effect: Ensure that the needed disk volume is mounted by waiting
; for it to be mounted if it is not mounted already.
;
; inputs: $drive The one-letter designator of the drive
; $id The volume id of the disk that needs to be mounted
; $name The diskette name to be used in a prompt if the
; volume is not already mounted
;
proc mount_volume($drive,$id,$name,$topic)
declare $volname,#fd,#case,#opentest,#reopen_help
loop
$volname=*volume($drive)
exit if ($volname == $id)
; ensure that there are no open files. It's not safe to change the disk
; if there's any chance of an open output file.
if (not #opentest) ; if we haven't already tested for open files
#opentest = 1
#fd = *open("nul")
close #fd
if (#fd > 1 or (#fd > 0 and #help__ == -1))
t:*chr(7)
t:The program needs to change disks so that the $name
t:disk is accessible, but it is not safe to do so because the program has
t:one or more files open.
t:
if ($topic <> "")
explain($topic)
else
t: The program must terminate immediately. Please report this
t: message to the program's author.
endif
foot
bye
endif
endif
if (#help__ >= 0)
close #help__
#help__ = -1
#reopen_help = 1
endif
t:$skip\Put the $name disk in drive $drive.
kbflush()
foot:Press RETURN after you have done this.
endloop
if (#reopen_help)
reopen_help__()
endif
endproc
; ----------------------------------------------------------
proc panic__($location,$msg) ; for internal error messages only
declare #paged
t:*chr(7)$skip\Internal error in \*$location:
t:
t: $msg
t:
t:The program will continue to run, but the results may not be valid.
t:Copy this message exactly, so you can report it to the program's author,
t:and exit as soon as possible. You may exit immediately by typing
t:Ctrl-C.
kbflush()
foot
endproc
; ----------------------------------------------------------
proc kbflush()
declare $junk
loop while (*keypress())
as $junk
endloop
endproc
; ----------------------------------------------------------
; getdr
;
; effect: assemble list of valid drive designators and return as string
;
; globals used: $cmdline
strfunc getdr__()
declare $drvlist,$tmp,#case,#tmp
.LOCALMATCH
; look for /drive=LIST... on command line
if ($cmdline contains "[-/]drive=[ \\t]*")
$drvlist=$right
if ($drvlist contains "[ \\t]")
$drvlist=$left
endif
return $drvlist
endif
if ($screentype == "Sharp LCD")
if (*freesp("P") == -1)
return "ABCDG"
else
return "ABCDGP"
endif
else ; it's not a Sharp
$drvlist=AB
$tmp=C
loop while (*freesp($tmp) > 0)
$drvlist=$drvlist$tmp
#tmp = *ascii($tmp) + 1
$tmp=*chr(#tmp)
endloop
return $drvlist
endif
endfunc
;----------------------------------------------------------
; explain - display help-file information. *Explain assumes the help-file is
; already open with the file descriptor in the global variable
; #help. It also tests the global variable #verbose which is 1 to
; enable explanations and 0 to disable. Note that some routines
; (e.g. *get_ans) declare a local copy of #verbose that is set to 1,
; thus enabling explanation on a local basis.
;
; A help-file has the following format:
; \id line
; [size line - if this line contains an int, set #fscale to its value]
; zero or more index lines in the format topic_name: offset (in bytes)
; zero or more topic entries beginning with \text topic_name
;
; *explain recognizes the following standard format markers in the help-file:
;
; \text - beginning of a topic
; \cls - execute a ch: command
; \foot - execute a foot command
;
; It may also recognize the following marker(s) in the near future:
;
; \more - like foot, but allows the user to choose between reading more or
; exiting explain (this is similar to the way HELP works in ED.)
; ----------------------------------------------------------
proc explain($topic)
declare #case,$line
.LOCALMATCH
if (not #verbose) ; explanations are turned off
return
else if (#help__ < 0)
t:There is no help-file available to this program.
foot ;